home *** CD-ROM | disk | FTP | other *** search
- unit Tranimag;
-
- interface
-
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- Forms, Dialogs, ExtCtrls;
-
- type
- TTranImage = class(TImage)
- private
- { Private declarations }
- FTransColor : TColor;
- FTransparent: Boolean;
- procedure PaintImageTransparent(Image: TImage);
- protected
- { Protected declarations }
- procedure Loaded; override;
- public
- { Public declarations }
- constructor Create(AOwner : TComponent); override;
- published
- { Published declarations }
- property TransColor: TColor read FTransColor write FTransColor default clSilver;
- property Transparent: Boolean read FTransparent write FTransparent default False;
- end;
-
- procedure Register;
-
- implementation
-
- procedure Register;
- begin
- RegisterComponents('Additional', [TTranImage]);
- end;
-
- constructor TTranImage.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FTransColor := clSilver;
- end;
-
- procedure TTranImage.Loaded;
- begin
- inherited Loaded; { always call the inherited Loaded first! }
- if not (csDesigning in ComponentState) then
- begin
- PaintImageTransparent(Self);
- end;
- end;
-
- procedure TTranImage.PaintImageTransparent(Image: TImage);
- var
- rect : TRect;
- color : TColor;
- begin
- if FTransparent and (Image.Picture <> nil) and (Image.Picture.Graphic is TBitmap) then
- try
- rect.Top := 0;
- rect.Left := 0;
- rect.Bottom := Image.Picture.Bitmap.Height;
- rect.Right := Image.Picture.Bitmap.Width;
-
- Image.Canvas.Brush.Color := Image.Parent.Brush.Color;
- {FTransColor := clSilver;}
- Image.Canvas.BrushCopy(rect, Image.Picture.BitMap, rect, FTransColor);
- except on E : Exception do
- end;
- end;
-
- end.